home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
ezw1v30a.zip
/
PDDEMO.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-05-28
|
8KB
|
262 lines
'=========================================================================
' PULLDOWN demonstration program
' Using EZWINDOWS library.
' Written by
' John C. Strong
' 3155 S.W. 178th Aveneu
' Aloha, OR 97006
'=========================================================================
DEFINT A-Z
DECLARE SUB qbmouse (a%, b%, c%, d%)
REM $DYNAMIC
REM $INCLUDE: 'qb.bi'
DIM HiPos1(10), HiPos2(10, 20), MaxSize(10), MaxItems(10), item$(10, 15), valid(10, 15), toggle(10, 15)
DIM reg AS regtype
col = 1 'assume color monitor
IF INSTR(COMMAND$, "BW") THEN col = 0 'user wants black/white
ms = 1 'assume mouse
IF INSTR(COMMAND$, "IM") THEN ms = 0 'user doesn't want mouse
COLOR 7, col * 5
bl = 25
IF INSTR(COMMAND$, "43") THEN bl = 43
IF INSTR(COMMAND$, "50") THEN bl = 50
WIDTH 80, bl
CLS
LOCATE 5, 5: PRINT "This is the PULLDOWN menu system!"
LOCATE 7, 5: PRINT "Here are some of its exciting features:"
LOCATE 9, 10
PRINT " Easily integrated into any existing QB 4.x program."
PRINT TAB(10); " Full mouse support."
PRINT TAB(10); " Full color control."
PRINT TAB(10); " Selections can by "; CHR$(34); "grayed"; CHR$(34); " out."
PRINT TAB(10); " Selections can be toggled inclusivley and exclusively."
PRINT TAB(10); " Mouse, cursor keys, or 'hot' keys can be used to"
PRINT TAB(12); "make a selection."
PRINT TAB(10); " 'Hot' key can be located anywhere in selection text."
PRINT TAB(10); " Menus pop up instantly, even on an XT!"
PRINT TAB(10); " Windows have a transparent shadow."
PRINT TAB(10); " Item will optionally blink upon selection."
PRINT TAB(10); " Dividing lines are inserted automatically."
LOCATE 22, 5: PRINT "Select Exit from File menu when you're ready to quit..."
LOCATE 24, 5: PRINT "You selected: ";
FOR i = 1 TO 10 'HiPos1() holds the location in each menu
HiPos1(i) = 1 'name for the 'hot' key - in this case it
NEXT i 'is the first letter in each name.
'Load in menu data from data statements at the end of this program
RESTORE PullDownMenuData
FOR menu = 1 TO 8
READ MaxItems(menu) 'Number of selections in each menu
READ MaxSize(menu) 'Max length of items in each menu
FOR slct = 1 TO MaxItems(menu)
READ item$(menu, slct) 'Text displayed for selection
READ HiPos2(menu, slct) 'Hot key for each selection in menu
READ valid(menu, slct) 'Determines if grayed out or not
READ toggle(menu, slct) 'Determines if selection can be
NEXT slct
NEXT menu
menuline$ = " File Edit View Search Run Debug Calls Options "
menurow = 1 'Screen row of menu line
menucol = 1 'Beginning column position
menuattr = 7 * 16 + 0 'Menu color
hotattr = 7 * 16 + 15 'Hot key hilite color
hiattr = 0 * 16 + 7 'Hilite bar color
NVattr = 7 * 16 + 8 'color for grayed-out
'selections
clearafter = 1 'erase menu after selection
menuslct = 1 'menu to start with
snd = 1 'turn sound on
shadow = 4
COLOR 0, 7
LOCATE 1, 1
PRINT menuline$;
CALL qbmouse(0, 0, 0, 0) 'initialize mouse
CALL qbmouse(1, 0, 0, 0) 'show mouse cursor
CALL qbmouse(10, 0, &H7000, 3844) 'set mouse cursor
DO
itemslct = -1
DEF SEG = &H40 'Check if ALT key is being pressed
x = PEEK(&H17) 'Bit 3 will be high if so
DEF SEG '2^3 = 8
qbmouse 3, b, mx, my 'get mouse info
mx = mx / 8 + 1: my = my / 8 + 1 'convert to text coordinates
'If ALT key is pressed, or mouse button pushed while cursor
'positioned on menu bar, then enter the pulldown routine
IF (x AND 8) OR (b = 1 AND my = 1) THEN
DEF SEG = 0
POKE (1050), PEEK(1052) 'empty keyboard buffer
DEF SEG
CALL PULLDOWN(menuline$, menurow, menucol, menuattr, hotattr, hiattr, NVattr, HiPos1(), HiPos2(), MaxSize(), MaxItems(), item$(), valid(), toggle(), ms, clearafter, menuslct, shadow, snd, menuslct, itemslct)
LOCATE 24, 5
COLOR 7, 5
PRINT "You selected: "; item$(menuslct, itemslct); " ";
IF toggle(menuslct, itemslct) <> 0 THEN
LOCATE 24, 40
IF toggle(menuslct, itemslct) > 0 THEN
PRINT "ON ";
ELSE
PRINT "OFF ";
END IF
END IF
seed = menuslct
IF seed = 0 THEN seed = 1
qbmouse 2, b, c, d
COLOR 0, 7
LOCATE 1, 1
PRINT menuline$;
qbmouse 1, b, c, d
END IF
LOOP UNTIL menuslct = 1 AND itemslct = 15 '<== change this if your
'exit option is located
'somewhere different
REDIM HiPos1(0), HiPos2(0, 0), MaxSize(0), MaxItems(0), item$(0, 0), valid(0, 0), toggle(0, 0)
qbmouse 2, 0, 0, 0 'turn off mouse cursor
COLOR 7, 0
CLS
END
'---------------------------- End of Program Code ----------------------------
'=============================================================================
' M e n u D a t a
'=============================================================================
PullDownMenuData:
'File menu
DATA 15,17
DATA "New Program",1,1,0
DATA "Open Program...",1,1,0
DATA "Merge...",1,1,0
DATA "Save...",1,1,0
DATA "Save As",6,1,0
DATA "Save All",3,1,0
'Here's an example of inserting a dividing line
DATA "~",0,0,0
DATA "Create File...",1,1,0
DATA "Load File...",1,1,0
DATA "Unload File...",1,1,0
DATA "~",0,0,0
DATA "Print...",1,1,0
DATA "DOS Shell",1,1,0
DATA "~",0,0,0
DATA "Exit",2,1,0
'Edit menu
DATA 8,22
DATA "Undo Alt+Backspace",1,1,0
DATA "Cut Shift+Del",3,0,0
DATA "Copy Ctrl+Ins",1,0,0
DATA "Paste Shift+Ins",1,1,0
DATA "Clear Del",3,1,0
DATA "~",0,0,0
DATA "New SUB...",5,1,0
DATA "New FUNCTION...",5,1,0
'View menu
DATA 9,24
DATA "SUBs... F2",1,1,0
DATA "Next SUB Shift+F2",2,1,0
DATA "Split",2,1,0
DATA "~",0,0,0
DATA "Next Statement",1,1,0
DATA "Output Screen F4",2,1,0
DATA "~",0,0,0
DATA "Included File",1,0,0
DATA "Included Lines",10,1,0
'Search menu
DATA 5,26
DATA "Find...",1,1,0
DATA "Selected Text Ctrl+\",1,1,0
DATA "Repeat Last Find F3",1,1,0
DATA "Change...",1,1,0
DATA "Label...",1,1,0
'Run menu
DATA 9,21
DATA "Start Shift+F5",1,1,0
DATA "Restart",1,1,0
DATA "Continue F5",3,1,0
DATA "Modify COMMAND$...",8,1,0
DATA "~",0,0,0
DATA "Make EXE File...",7,1,0
DATA "Make Library...",6,1,0
DATA "~",0,0,0
DATA "Set Main Module...",5,1,0
'Debug menu
DATA 13,29
DATA "Add Watch...",1,1,0
DATA "Instant Watch... Shift+F9",1,1,0
DATA "Watchpoint...",1,1,0
DATA "Delete Watch...",1,0,0
DATA "Delete All Watch",3,0,0
DATA "~",0,0,0
DATA "Trace On",1,1,0
DATA "History On",1,1,0
DATA "~",0,0,0
DATA "Toggle Breakpoint F9",8,1,0
DATA "Clear All Breakpoints",1,1,0
DATA "Break On Errors",10,1,0
DATA "Set Next Statement",1,0,0
'Calls menu
DATA 1,17
DATA "PDDEMO.BAS",1,1,0
'Options menu
DATA 5,17
DATA "Display...",1,1,0
DATA "Set Paths...",5,1,0
DATA "Right Mouse...",7,1,0
DATA "Syntax Checking",1,1,1
DATA "Full Menus",1,1,1
REM $STATIC
SUB qbmouse (a, b, c, d)
SHARED reg AS regtype
reg.ax = a
reg.bx = b
reg.cx = c
reg.dx = d
CALL interrupt(&H33, reg, reg)
a = reg.ax
b = reg.bx
c = reg.cx
d = reg.dx
END SUB